1 Streszczenie problemu

Celem projektu jest określenie przyczyn stopniowego zmniejszania się długości śledzi oceanicznych wyławianych w Europie. Do analizy wykorzystano dane o pomiarze oraz warunkach życia śledzia oceanicznego w Europie z okresu ponad pięćdziesięciu lat. Analizowane dane obejmowały ponad 50 tysięcy rekordów. W celu rozpoznania przyczyn malejącego rozmiaru śledzia dokonano predykcji jego rozmiaru oraz przeprowadzono analizę ważności atrybutów najlepszego znalezionego modelu regresji. Analizując rozkład wartości danych oraz współczynnik korelacji atrybutów stwierdzono, iż dla zmiennych lcop1, lcop2, cumf oraz totaln istnieje silna współliniowość i atrybuty te powinny zostać usunięte, ponieważ mogą wpływać negatywnie na wyniki predykcji.Na podstawie uzyskanych wyników wnioskować można, że na zmniejszanie rozmiaru śledzi największy wpływ ma temperatura przy powierzchni wody, jednak bardzo istotny jest także miesiąc połowu. Można więc przypuszczać, że przyczyną zmniejszania się śledzi jest zjawisko globalnego ocieplenia.

2 Wykorzystane biblioteki

library('knitr')
library('dplyr')
library('ggplot2')
library('plotly')
library('reshape2')
library('corrplot')
library('caret')

3 Zbiór danych

Aby wyniki raportu były powtarzalne ustawione zostało ziarno.

set.seed(22)

3.1 Wczytywanie danych

Dane zostały wczytane z pliku CSV znajdującego się pod adresem http://www.cs.put.poznan.pl/dbrzezinski/teaching/zed/sledzie.csv. Zaznaczono również, że brakujące wartości zostały oznaczone w zbiorze danych znakiem ?. Przedstawiono również 10 pierwszych wierszy zbioru danych w celu zapoznania się z ich strukturą.

df <-  read.csv(url("http://www.cs.put.poznan.pl/dbrzezinski/teaching/zed/sledzie.csv"), na.strings ="?")
df <- tbl_df(df)


head(df,10)
## # A tibble: 10 × 16
##        X length   cfin1   cfin2   chel1    chel2   lcop1    lcop2  fbar
##    <int>  <dbl>   <dbl>   <dbl>   <dbl>    <dbl>   <dbl>    <dbl> <dbl>
## 1      0   23.0 0.02778 0.27785 2.46875       NA 2.54787 26.35881 0.356
## 2      1   22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 3      2   25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 4      3   25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 5      4   24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 6      5   22.0 0.02778 0.27785 2.46875 21.43548 2.54787       NA 0.356
## 7      6   24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 8      7   23.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 9      8   22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 10     9   22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## # ... with 7 more variables: recr <int>, cumf <dbl>, totaln <dbl>,
## #   sst <dbl>, sal <dbl>, xmonth <int>, nao <dbl>

3.2 Opis atrybutów

  • length: długość złowionego śledzia [cm]
  • cfin1: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 1]
  • cfin2: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2]
  • chel1: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1]
  • chel2: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2]
  • lcop1: dostępność planktonu [zagęszczenie widłonogów gat. 1]
  • lcop2: dostępność planktonu [zagęszczenie widłonogów gat. 2]
  • fbar: natężenie połowów w regionie [ułamek pozostawionego narybku]
  • recr: roczny narybek [liczba śledzi]
  • cumf: łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku]
  • totaln: łączna liczba ryb złowionych w ramach połowu [liczba śledzi]
  • sst: temperatura przy powierzchni wody [°C]
  • sal: poziom zasolenia wody [Knudsen ppt]
  • xmonth: miesiąc połowu [numer miesiąca]
  • nao: oscylacja północnoatlantycka [mb]

3.3 Podsumowanie informacji o danych

Zbiór danych posiada następujące rozmiary

dim(df)
## [1] 52582    16

Poniżej przedstawiono podstawowe statystyki dla badanego zbioru danych.

kable(summary(df))
length cfin1 cfin2 chel1 chel2 lcop1 lcop2
Min. :19.0 Min. : 0.0000 Min. : 0.0000 Min. : 0.000 Min. : 5.238 Min. : 0.3074 Min. : 7.849
1st Qu.:24.0 1st Qu.: 0.0000 1st Qu.: 0.2778 1st Qu.: 2.469 1st Qu.:13.427 1st Qu.: 2.5479 1st Qu.:17.808
Median :25.5 Median : 0.1111 Median : 0.7012 Median : 5.750 Median :21.673 Median : 7.0000 Median :24.859
Mean :25.3 Mean : 0.4458 Mean : 2.0248 Mean :10.006 Mean :21.221 Mean : 12.8108 Mean :28.419
3rd Qu.:26.5 3rd Qu.: 0.3333 3rd Qu.: 1.7936 3rd Qu.:11.500 3rd Qu.:27.193 3rd Qu.: 21.2315 3rd Qu.:37.232
Max. :32.5 Max. :37.6667 Max. :19.3958 Max. :75.000 Max. :57.706 Max. :115.5833 Max. :68.736
NA NA’s :1581 NA’s :1536 NA’s :1555 NA’s :1556 NA’s :1653 NA’s :1591
fbar recr cumf totaln sst sal xmonth
Min. :0.0680 Min. : 140515 Min. :0.06833 Min. : 144137 Min. :12.77 Min. :35.40 Min. : 1.000
1st Qu.:0.2270 1st Qu.: 360061 1st Qu.:0.14809 1st Qu.: 306068 1st Qu.:13.60 1st Qu.:35.51 1st Qu.: 5.000
Median :0.3320 Median : 421391 Median :0.23191 Median : 539558 Median :13.86 Median :35.51 Median : 8.000
Mean :0.3304 Mean : 520367 Mean :0.22981 Mean : 514973 Mean :13.87 Mean :35.51 Mean : 7.258
3rd Qu.:0.4560 3rd Qu.: 724151 3rd Qu.:0.29803 3rd Qu.: 730351 3rd Qu.:14.16 3rd Qu.:35.52 3rd Qu.: 9.000
Max. :0.8490 Max. :1565890 Max. :0.39801 Max. :1015595 Max. :14.73 Max. :35.61 Max. :12.000
NA NA NA NA NA’s :1584 NA NA

4 Brakujące wartości

Ilość brakujących wartości dla poszczególnych zmiennych wygląda następująco:

na_count <-sapply(df, function(y) sum(length(which(is.na(y)))))
na_count <- data.frame(na_count)
na_count
##        na_count
## X             0
## length        0
## cfin1      1581
## cfin2      1536
## chel1      1555
## chel2      1556
## lcop1      1653
## lcop2      1591
## fbar          0
## recr          0
## cumf          0
## totaln        0
## sst        1584
## sal           0
## xmonth        0
## nao           0

Usunięto brakujące wartości ze zbioru danych poprzez podstawienie do zmiennych średniej arytmetycznej z danego połowu. Dane zostały pogrupowane wzlędem atrybutu nao.

df2 <- df %>%
  group_by(nao) %>%
  mutate(
          cfin1 = mean(cfin1, na.rm = TRUE),
          cfin2 = mean(cfin2, na.rm = TRUE),
          chel1 = mean(chel1, na.rm = TRUE),
          chel2 = mean(chel2, na.rm = TRUE),
          lcop1 = mean(lcop1, na.rm = TRUE),
          lcop2 = mean(lcop2, na.rm = TRUE),
          sst = mean(sst, na.rm = TRUE)
                                      ) %>% 
  select(-X)

5 Rozkład wartości atrybutów

Poniżej zostały przedstawione histogramy dla atrybutów w zbiorze danych. Można zauważyć, że poza atrybutem length, który ma rozkład zbliżony do normalnego, reszta atrybutów ma bardzo nieregularne rozkłady wartości ze względu na wysoką powtarzalność danych.

  headers <- c(names(df2))
  for (i in headers){
  xcol <- df2[i]
  a <- ggplot(df2,aes(xcol)) + geom_histogram(col="black", fill="#3366FF", 
                 alpha = .75 , bins = 30) + xlab(i) + ggtitle(paste("Histogram zmiennej " ,i)) + xlim(min(xcol),max(xcol)) + theme_minimal() + theme(plot.title = element_text(hjust = 0.5))
  print(a)

}

5.1 Zmiana rozmiaru śledzi w czasie

Na interaktywnym wykresie zobrazowano jak zmieniał się rozmiar śledzia odkąd rozpoczęto obserwację.

 lengthInTime <- ggplot(df,aes(X,length)) + geom_smooth(method="auto", se=FALSE) + xlab("observation") + geom_hline(aes(yintercept=mean(length)),linetype="dashed",colour="red")
 ggplotly(lengthInTime)

Zauważono wyraźny spadek rozmiaru śledzia w badanym okresie.

6 Korelacja zmiennych w zbiorze danych

W celu zbadania występowania korelacji między zmiennymi utworzono macierz korelacji.

Matrix <- cor(df2)
Matrix <- round(Matrix,2)
corrplot(Matrix, method="color",type = "upper",  addCoef.col = "black", tl.col="black")

Zmienne między którymi występuje silna współliniowość (tj. takie, dla których współczynnik korelacji przyjmuje wartości wyższe od 0,7) powinny zostać wyeliminowane. W badanym przypadku współczynnik korelacji przekroczył wartość 0,7 dla czterech zmiennych: lcop1, lcop2, cumf oraz totaln, co stanowi podstawę do ich eliminacji.

7 Regresja

Zgodnie z poprzednim punktem dokonano wyboru atrybutów, które pomogą poprawnie przewidzieć wielkość śledzia i nie będą negatywnie wpływać na wyniki. Podzielono dane na zbiory treningowy (70%) i testowy (30%). Metodą oceny regresora będzie 10- krotna walidacja krzyżowa. Do budowy modelu regresora wybrano algorytm Random Forest ze względu na większą dokładność predykcji oraz skuteczność przy większej ilości danych.

fit <- train(length~.,
              data = herringTrain,
              method = "rf",
              trControl = ctrl,
              importance =TRUE,
              ntree = 10)

Dla uzyskanego modelu obliczono wartość RMSE, czyli średniej kwadratowej błędów oraz współczynik determinacji R^2, na podstawie których szacuje się, że zbudowany model jest wzglednie zadowalający.

fit
## Random Forest 
## 
## 36810 samples
##    10 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (6 fold, repeated 10 times) 
## Summary of sample sizes: 30675, 30675, 30675, 30675, 30675, 30675, ... 
## Resampling results across tuning parameters:
## 
##   mtry  RMSE      Rsquared 
##    2    1.167209  0.5008894
##    6    1.142865  0.5214394
##   10    1.138733  0.5249882
## 
## RMSE was used to select the optimal model using  the smallest value.
## The final value used for the model was mtry = 10.

Poniższy wykres prezentuje przewidywany oraz rzeczywisty zakres długości śledzia.

p <- ggplot(predictionPlot,aes(x=length, y=prediction, color=length)) + geom_point() + geom_abline(color="red") + xlim(min(actual),max(actual)) + ylim(min(actual),max(actual)) + xlab("actual length") + ylab("predicted length")

ggplotly(p)

8 Ważność atrybutów

W celu rozpoznania przyczyn malejącego rozmiaru śledzia przeprowadzono analizę ważności atrybutów najlepszego znalezionego modelu regresji.

atrrImp <- varImp(fit)

plot(atrrImp)

Na powyższym wykresie atrybuty zostały uporządkowane malejąco według stopnia istotności. Na jego podstawie stwierdzić można, że dwoma najważniejszymi atrybutami są temperatura przy powierzchni wody oraz miesiąc połowu. Oznacza to, że wymienione dwa czynniki w głównej mierze mają wpływ na zmniejszanie się rozmiaru śledzi.